00100	C THIS ROUTINE FINDS KEY WORDS IN I ARRAY AND PUTS THEIR KEY NUMS
00200	C INTO THE IX ARRAY.  IX ARRAY ADVANCES 2 WORDS AT A TIME.
00300	C IF 2ND WRD OF EACH PAIR IS NON-ZERO THEN 1ST IS FLT. PT. NUM.
00400	C KCNT IS WORD COUNT OF INPUT STRING.
00500	        SUBROUTINE MPACK(KCNT, I,IX,IPTR)
00600		INTEGER FQDR
00700		COMMON/IGEN/IGEN /FQDR/FQDR(28,27),INSN
00800	CIN	COMMON /TR/Q(80),QX(100),IIX(100),LX(12),INST(27,4),K
00900		COMMON /TR/LX(12),K
01000		DIMENSION I(1),WDS(18)
01100		COMMON /WDZ/WDZ(14),JWD(12)
01200		DATA WDS/'OUT','OSC','AD2','RAN','ENV','STR','AD3','AD4',
01300		1 'MLT','DIV','RAH','END','REV','OPT','NOS','SUB','INP','COS'/,
01400		1 WDZ/'PLAY','FINI','SRAT','NCHN','PRIN','CHA','POWE','SRT',
01500		1 'WORD','GEN','SEG','SIN','INS','UNIT'/,
01600		1 JWD/'C','D','E','F','G','A','B','P','*','/',0,0/
01700		DATA IPP/'P'/,IFF/'F'/,IBB/'B'/,IAA/'A'/,IOO/'O'/,IRR/'R'/,
01800		1 IEE/'E'/,ISS/'S'/,IMM/'M'/,III/'I'/,ILL/'L'/,ITT/'T'/,
01900		1 IDD/'D'/,I2/'2'/,I3/'3'/,I4/'4'/,IUU/'U'/,ICC/'C'/,IHH/'H'/
02000		1,IVV/'V'/,IYY/'Y'/,IWW/'W'/,I0/'0'/,I9/'9'/,INN/'N'/,IQQ/'Q'/
02100		1,IPP/'P'/,IGG/'G'/,ISTAR/'*'/,KSLA/'/'/
02200		IX=I(1)
02300	CC	DO 100 K=1,12
02400	C LOOK FOR PUNCTUATION, ARITHMETIC OPERATORS, ETC.
02500	CC100	IF(IX.EQ.LX(K))RETURN
02600	101	N=I(2)
02700		L=I(3)
02800		CALL PACKER(RNAM,I)
02900	C NOW RNAM HAS PACKED WORD
03000		IF(IGEN.NE.2)GO TO 1000
03100	C IGEN=2=READING INSTRUMENT DEFINITION
03200	CODE NUMS ARE 1-13 FOR UNIT GENS., 100+ FOR B, 200+ FOR P, 300+ FOR F.
03300	C ORD. OF UNIT GENS:OUT,OSC,AD2,RAN,ENV,STR,AD3,AD4,MLT,DIV,RAH,END,REV
03400	C		OPT,NOS,SUB,INP,COS  
03500	C OPT=OPTIONAL, NOS=OSC WHICH ACCEPTS NEG. FREQ., COS=CONTINUING NOS.
03600		IF(IX.EQ.IPP)GO TO 14
03700		IF(IX.EQ.IFF)GO TO 15
03800		IF(IX.EQ.IBB)GO TO 16
03900		IF(IX.EQ.IDD)GO TO 142
04000	C  FPN = FREQ. PARAM. NUM.    DPN = DUR. PARAM. NUM.
04100		DO 102 IX=1,18
04200	102	IF(RNAM.EQ.WDS(IX))RETURN
04300	C SENDS BACK NUM FOR 1 TO 17
04400	C IF NOT A KNOWN WORD THEN ERROR
04500	999	IF(IGEN.EQ.2)GO TO 28
04600	C  SO INST NAME CAN START WITH 'P' (BUT NO 'P12X', ETC.)
04700		CALL ERR(5)
04800	
04900	141	JCVT=-1
05000		GO TO 143
05100	142	JCVT=1
05200	143	N=L
05300		L=I(4)
05400	C SHIFT POINTER 1 TO RIGHT
05500		KCNT=KCNT-1
05600		GO TO 144
05700	14	JCVT=0
05800	144	J=200
05900	C PN
06000	18	IF(N.LT.I0.OR.N.GT.I9)GO TO 999
06100		K2=0
06200		K1=NASCI(N)
06400	C  CONVERTS ASCII CHAR. TO INTEGER 
06500		IF(KCNT.EQ.2)GO TO 19
06600	C ARE THERE 2 DIGITS AFTER P, F OR B?
06700		IF(L.LT.I0.OR.L.GT.I9)GO TO 999
06800		K1=K1*10
07000		K2=NASCI(L)
07100	19	IX=J+K1+K2
07200		IF(JCVT.EQ.0)RETURN
07300	C NOW SET UP A FREQ OR DUR FLAG 
07400		FQDR(K1+K2-2,INSN)=JCVT
07500		JCVT=0
07600		RETURN
07700	15	IF(N.EQ.IPP)GO TO 141
07800	C JUMP FOR 'FP'  = FREQ PARAM
07900		J=300
08000	C  FN
08100		GO TO 18
08200	16	J=100
08300	C BN
08400		GO TO 18
08500	
08600	C NEXT FOR OTHER (MUS10 TYPE) KEY WORDS.
08700	1000	IF(KCNT.LT.3)GO TO 2000
08800	C JUMP TO FIND NOTE NAMES, PARAMS, FUNCTS.
08900		DO 1 K=1,15
09000		IF(RNAM.NE.WDZ(K))GO TO 1
09100	C THIS LIST BEGINS WITH CODE NUM. 400:
09200	C PLAY,FINI,SRATE,NCHNS,PRINT,CHA,POWER,SRT,END,GEN,DUR,FREQ,INS,UNIT GEN
09300		IX=K+399
09400	CC	IF(K.EQ.9)IX=12
09500	CC	IF(K.EQ.15)IX=13
09600		RETURN
09700	1	CONTINUE
09800		IF(IX.EQ.IPP)GO TO 14
09900	C CHECK FOR A PARAM NUM OR INST. NAME
10000	28	IX=-IPTR
10100	C SEND BACK NEG. POINTER TO I ARRAY SO IT WILL LOOK FOR INST. NAME.
10200		RETURN
10300	
10400	2000	DO 2 K=1,12
10500	C FINDS (P1, P21, ETC.)
10600	2	IF(IX.EQ.JWD(K))GO TO(5,11,7,4,6,8,9,14,15,16)K
10700		GO TO 28
10800	C A FUNC??
10900	4	IF(N.GE.I0.AND.N.LE.I9)GO TO 15
11000		IF(KCNT.EQ.3)GO TO 28
11100		IX=510
11200		GO TO 36
11300	5	IX=501
11400	C 'C'
11500	C AT THIS POINT NOTE NUMBERS RUN FROM 500 TO 520  (CF TO BS)
11600		GO TO 36
11700	6	IX=513
11800	C THE NOTE 'G'
11900	36	IF(KCNT.EQ.1)RETURN
12000		IF(N.EQ.IFF)GO TO 39
12100		IF(N.NE.ISS) GO TO 28
12200	C NOW IT'S NOT A NOTE
12300	40	IX=IX+1
12400	C SHARP
12500		RETURN
12600	39	IX=IX-1
12700	C FLAT
12800		RETURN
12900	11	IX=504
13000	C  'D'
13100		GO TO 36
13200	7	IF(KCNT.EQ.3)GO TO 4
13300	C 'END' OR NOTE 'E'?
13400		IX=507
13500		GO TO 36
13600	8	IX=516
13700		GO TO 36
13800	9	IX=519
13900		GO TO 36
14000		END
14100	
14200	      SUBROUTINE ERR(N)
14300	      GO TO (1,2,3,4,5)N
14400	1      TYPE 101
14500	      STOP
14600	101      FORMAT(' MISSING SEMICOLON')
14700	2      TYPE 102
14800	      STOP
14900	102      FORMAT(' MISSING PARENTHESIS')
15000	3      TYPE 103
15100	      STOP
15200	103      FORMAT(' MISSING COMMA')
15300	4      TYPE 104
15400	104      FORMAT(' MISSING PLAY;')
15500	5	TYPE 105
15600	105	FORMAT(' UNKNOWN WORD')
15700	      STOP
15800	      END
15900	
16000	      SUBROUTINE ARITH(Y,W,LL)
16100	      DIMENSION W(1)
16200	      COMMON /AR/IOP
16300	7      X=W(LL-1)
16400	      GO TO (1,2,3,4,5),IOP
16500	1      IF(Y.EQ.0)Y=16.
16600	C  0 WILL ALWAYS TURN INTO 16 WITH MULT OR DIV.
16700		X=X*Y
16800	      GO TO 6
16900	2      IF(Y.EQ.0)Y=16.
17000	       X=X/Y
17100	      GO TO 6
17200	3      X=X-Y
17300	      GO TO 6
17400	4      X=X+Y
17500		GO TO 6
17600	5	X=X**Y
17700	6      W(LL-1)=X
17800	      END
17900		SUBROUTINE PACKER(NAM,INP)
18000		DATA IBLA/' '/,ISEMI/';'/,IARO/"575004020100/,IEQU/'='/
18100	C****** THE BIG NUMBER=LEFT ARROW
18200	C11	DOUBLE PRECISION NAM
18300		DIMENSION INP(1),KNM(5)
18400		DATA KK/128/,LL/"377777777777/,JJ/"2000000000/
18500		1 , MM/"774000000000/
18600	
18700		NAM=0  
18800		DO 1 J=1,80
18900		N=INP(J)
19000		IF(N.EQ.IARO.OR.N.EQ.IEQU)GO TO 2
19100	1	IF(N.EQ.IBLA.OR.N.EQ.ISEMI)GO TO 2
19200	2	II=J
19300		J=J-1
19400		N=J
19500		IF(J.GT.4)N=4
19600	4	DO 10 K=1,4
19700		IF(K.GT.N)GO TO 11
19800		KNM(K)=INP(K)
19900		GO TO 10
20000	11	KNM(K)=IBLA
20100	10	CONTINUE
20200		KNM(5)=IBLA
20300	C ABOVE FOR PDP10 ONLY*********
20400	C N=WDCNT 
20500		DO 12 K=5,1,-1
20600		NAM=NAM .OR. (KNM(K) .AND. MM)
20700		IF (K.EQ.1)RETURN
20800	17	IF (NAM.GE.0)GO TO 13
20900		NAM = (( NAM .AND. LL)/KK) .OR. JJ
21000		GO TO 12
21100	13	NAM = NAM / KK
21200	12	CONTINUE
21300	
21400		END